home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / backup.lqr / BACK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-06-03  |  9.2 KB  |  221 lines
  1.  
  2.  
  3. program Backup;
  4.  
  5. {------------------------------------------------------------------------------
  6.  
  7.        Backup is a program that writes a batch file that copies new files
  8.  from an original to a backup disk. It uses MSDOS function calls(described
  9.  in the DOS Technical Reference Manual) to extract the file names from the
  10.  disk directory of the original disk. The filenames are stored in an array,
  11.  and checked against the directory of the backup disk to see if they already
  12.  exist. If a file does not exist on the backup disk then the file name is
  13.  written to a DOS batch file with the appropriate 'COPY' command format.
  14.        The major part of this program was adapted from the sample TURBO
  15.  PASCAL program 'QDL'. The modifications and additions were made by Al Wang,
  16.  Children's Hospital Research Foundation, Cincinnati,Ohio 45229
  17.  
  18. ------------------------------------------------------------------------------}
  19. {$I-,U-,C-}
  20.  
  21.  
  22. type                            { TYPE declarations }
  23.   Registers =
  24.     record           { register pack used in MSDos call }
  25.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  26.     end;
  27.   Char80arr     = array [ 1..80 ] of Char;
  28.   String80      = string[ 80 ];
  29.   filename      = string[14];
  30.  
  31. var                              { VARIABLE declarations }
  32.   DTA : array [ 1..43 ] of Byte;       { Data Transfer Area Buffer }
  33.   DTAseg,                              { DTA Segment before exicution }
  34.   DTAofs,                              { DTA Offset    "        "     }
  35.   SetDTAseg,                           { DTA Segment and Offset set after }
  36.   SetDTAofs,                           { start of program }
  37.   Error,                               { Error return }
  38.   Stop,                                { Returns the number of files }
  39.   I, J,index,                          { used as counters }
  40.   Option : Integer;                    { used to specify file types }
  41.   Regs : registers;                    { register pack for the DOS call }
  42.   Buffer,                              { generic Buffer }
  43.   NamR : String80;                     { file name }
  44.   Mask : Char80arr;                    { file Mask }
  45.   Fname: filename;                     { file name }
  46.   Backup : Text;                       { output batch file }
  47.   Dir : array [1..512] of filename;    { array of file names }
  48.   source,dest : string[2];             { drive specifications}
  49.  
  50. {------------------------------------------------------------------------------
  51.      SetDTA resets the current DTA to the new address specified in the
  52. parameters 'SEGMENT' and 'OFFSET'.
  53. ------------------------------------------------------------------------------}
  54.  
  55. procedure SetDTA( Segment, Offset : Integer; var Error : Integer );
  56. begin
  57.   Regs.AX := $1A00;         { Function used to set the DTA }
  58.   Regs.DS := Segment;       { store the parameter Segment in DS }
  59.   Regs.DX := Offset;        {   "    "      "     Offset in DX }
  60.   MSDos( Regs );            { Set DTA location }
  61.   Error := Regs.AX and $FF; { get Error return }
  62. end; { of proc SetDTA }
  63.  
  64. {------------------------------------------------------------------------------
  65.      GetCurrentDTA is used to get the current Disk Transfer Area ( DTA )
  66. address.  A function code of $2F is stored in the high Byte of the AX
  67. register and a call to the predefined procedure MSDos is made.  This can
  68. also be accomplished by using the "Intr" procedure with the same register
  69. record and a $21 specification for the interrupt.
  70. ------------------------------------------------------------------------------}
  71.  
  72. procedure GetCurrentDTA( var Segment, Offset : Integer;
  73.                          var Error : Integer );
  74. begin
  75.   Regs.AX := $2F00;    { Function used to get current DTA address }
  76.                        { $2F00 is used instead of $2F shl 8 to save
  77.                          three assembly instructions.  An idea for
  78.                          optimization. }
  79.   MSDos( Regs );       { Exicute MSDos function request }
  80.   Segment := Regs.ES;  { Segment of DTA returned by DOS }
  81.   Offset := Regs.BX;   { Offset of DTA returned }
  82.   Error := Regs.AX and $FF;
  83. end; { of proc GetCurrentDTA }
  84.  
  85.  
  86. {------------------------------------------------------------------------------
  87.      GetFirst gets the first directory entry of a particular file Mask.  The
  88. Mask is passed as a parameter 'Mask' and,  the Option was previosly specified
  89. in the SpecifyOption procedure.
  90. ------------------------------------------------------------------------------}
  91.  
  92. procedure GetFirst( Mask : Char80arr; var NamR : String80;
  93.                     Segment, Offset : Integer; Option : Integer;
  94.                     var Error : Integer );
  95. var
  96.   I : Integer;
  97. begin
  98.   Error := 0;
  99.   Regs.AX := $4E00;          { Get first directory entry }
  100.   Regs.DS := Seg( Mask );    { Point to the file Mask }
  101.   Regs.DX := Ofs( Mask );
  102.   Regs.CX := Option;         { Store the Option }
  103.   MSDos( Regs );             { Exicute MSDos call }
  104.   Error := Regs.AX and $FF;  { Get Error return }
  105.   I := 1;                    { initialize 'I' to the first element }
  106.   repeat                     { Enter the loop that reads in the }
  107.                              { first file entry }
  108.     NamR[ I ] := Chr( mem[ Segment : Offset + 29 + I ] );
  109.     I := I + 1;
  110.   until ( not ( NamR[ I - 1 ] in [ ' '..'~' ] ));
  111.   NamR[ 0 ] := Chr( I - 1 );  { set string length because assigning }
  112.                               { by element does not set length }
  113. end; { of proc GetFirst }
  114.  
  115. {------------------------------------------------------------------------------
  116.      GetNextEntry uses the first bytes of the DTA for the file Mask, and
  117. returns the next file entry on disk corresponding to the file Mask.
  118. ------------------------------------------------------------------------------}
  119.  
  120. procedure GetNextEntry( var NamR : String80; Segment, Offset : Integer;
  121.                         Option : Integer; var Error : Integer );
  122. var
  123.   I : Integer;
  124. begin
  125.   Error := 0;
  126.   Regs.AX := $4F00;           { Function used to get the next }
  127.                               { directory entry }
  128.   Regs.CX := Option;          { Set the file option }
  129.   MSDos( Regs );              { Call MSDos }
  130.   Error := Regs.AX and $FF;   { get the Error return }
  131.   I := 1;
  132.   repeat
  133.     NamR[ I ] := Chr( mem[ Segment : Offset + 29 + I ] );
  134.     I := I + 1;
  135.   until ( not ( NamR[ I - 1 ] in [ ' '..'~' ] ));
  136.   NamR[ 0 ] := Chr( I - 1 );
  137. end; { of proc GetNextEntry }
  138.  
  139. {-----------------------------------------------------------------------------
  140.  
  141.   This function determines if a given file name exists. The file name may
  142.   include drive specifications and wildcards. This function was taken from
  143.   page 96 of the TURBO PASCAL reference manual.
  144.  
  145. ------------------------------------------------------------------------------}
  146.  
  147. function Exist(Filname: filename): Boolean;
  148. var
  149.   Fil:file;
  150. begin
  151.   Assign(Fil,Filname);
  152.   {$I-}
  153.   Reset(Fil);
  154.   {$I+}
  155.   Exist:=(IOresult=0)
  156. end; { of Exist }
  157.  
  158. {
  159.               main body of program QDL
  160. }
  161.  
  162. begin
  163.   write('Enter source drive specification(letter, colon, enter):');
  164.   readln(source);
  165.   write('Enter destination drive specification(letter, colon, enter):');
  166.   readln(dest);
  167.   Assign(Backup,'TRANSFER.BAT');
  168.   Rewrite(Backup);
  169.   index:=2;
  170.   for I := 1 to 512 do dir[ I ] :='';
  171.   for I := 1 to 21 do DTA[ I ] := 0;  { Initialize the DTA Buffer }
  172.     for I := 1 to 80 do begin         { Initialize the Mask and }
  173.       Mask[ I ] := Chr( 0 );        { file name buffers }
  174.       NamR[ I ] := Chr( 0 );
  175.     end;
  176.   NamR[ 0 ] := Chr( 0 );              { Set the file name length to 0 }
  177.   GetCurrentDTA( DTAseg, DTAofs, Error );  { Get the current DTA address }
  178.   if ( Error <> 0 ) then begin             { Check for errors }
  179.     WriteLn( 'Unable to get current DTA' );
  180.     WriteLn( 'Program aborting.' );         { and abort. }
  181.     Halt;                                   { end program now }
  182.   end;
  183.   SetDTAseg := Seg( DTA );
  184.   SetDTAofs := Ofs( DTA );
  185.   SetDTA( SetDTAseg, SetDTAofs, Error );        { Reset DTA addresses }
  186.   if ( Error <> 0 ) then begin                  { Check for errors }
  187.     WriteLn( 'Cannot reset DTA' );          { Error message }
  188.     WriteLn( 'Program aborting.' );
  189.     Halt;                                   { end program }
  190.   end;
  191.   Error := 0;
  192.   Buffer[ 0 ] := Chr( 0 );                      { Set Buffer length to 0 }
  193.   Option:=4;                                    { Get file Option }
  194.   Buffer:=source+'????????.???';
  195.   for I := 1 to length( Buffer ) do       { Assign Buffer to Mask }
  196.     Mask[ I ] := Buffer[ I ];
  197.   GetFirst( Mask, NamR, SetDTAseg, SetDTAofs, Option, Error );
  198.   if ( Error = 0 ) then begin            { Get the first directory entry }
  199.       dir[1]:=NamR;
  200.   end
  201.   else WriteLn( 'File ''', Buffer, ''' not found.' );
  202.   while ( Error = 0 ) do begin
  203.     GetNextEntry( NamR, SetDTAseg, SetDTAofs, Option, Error );
  204.     if ( Error = 0 ) then
  205.           dir[index]:=NamR;
  206.           index:=index+1;
  207.           Stop:=index;
  208.   end;
  209.   for index:= 1 to Stop do begin
  210.     if ( dir[index]<> '' ) then begin
  211.       Fname:=dest+dir[index];
  212.       if not Exist(Fname) then
  213.          writeln(Backup,'COPY '+source+dir[index]+' '+dest);
  214.     end;
  215.   end;
  216.   SetDTA( DTAseg, DTAofs, Error );
  217.   Close(Backup);
  218. end. { end Main }
  219.  
  220.  
  221.